perm filename CYCDRF.LSP[3,LMM] blob sn#037475 filedate 1973-04-21 generic text, type T, neo UTF8

(DEFPROP CYCDRFFNS
 (CYCDRFFNS NODEPICK1 INTERSECTION)
VALUE)

(DEFPROP NODEPICK1
 (LAMBDA(FCM NF)
  (PROG	(X Y Z Y2)
	(SETQ X (MAPCAR (FUNCTION FNODLST) FCM))
	(RETURN
	 (FOR Y
	      IN
	      NF
	      LIST
	      (SETQ Y2 (CDR Y))
	      (SETQ Z NIL)
	      (COND ((NULL Y2) (GO A)))
	      (SETQ Z (CDR (ASSOC (CAR Y2) X)))
	      B
	      (SETQ Y2 (CDR Y2))
	      (COND ((NULL Y2) (GO A)))
	      (SETQ Z (INTERSECTION Z (CDR (ASSOC (CAR Y2) X))))
	      (GO B)
	      A
	      (CONS (CAR Y) Z)))))
EXPR)

(DEFPROP INTERSECTION
 (LAMBDA (A B) (FOR NEW X IN A WHEN (MEMBER X B) LIST X))
EXPR)